home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / font.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  33.8 KB  |  917 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test out Tk's "font" command
  2. # plus the procedures in tkFont.c.  It is organized in the
  3. # standard fashion for Tcl tests.
  4. #
  5. # Copyright (c) 1996 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # SCCS: @(#) font.test 1.20 97/07/22 15:34:12
  11.  
  12. if {[string compare test [info procs test]] != 0} {
  13.     source defs
  14. }
  15.  
  16. catch {destroy .b}
  17. toplevel .b
  18. wm geom .b +0+0
  19. update idletasks
  20.  
  21. proc setup {} {
  22.     catch {destroy .b.f}
  23.     catch {font delete xyz}
  24.     label .b.f 
  25.     pack .b.f
  26.     update
  27. }
  28.  
  29. label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Helvetica -12 bold"
  30. pack .b.l
  31. canvas .b.c -closeenough 0 
  32. .b.c create text 0 0 -tags text -anchor nw -just left -font "Helvetica -12 bold"
  33. pack .b.c
  34. update
  35.  
  36. set ax [winfo reqwidth .b.l]
  37. set ay [winfo reqheight .b.l]
  38. proc getsize {} {
  39.     update
  40.     return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
  41. }
  42.  
  43. proc csetup {{str ""}} {
  44.     focus -force .b.c
  45.     .b.c dchars text 0 end
  46.     .b.c insert text 0 $str
  47.     .b.c focus text
  48. }
  49.  
  50. setup
  51.  
  52. case $tcl_platform(platform) {
  53.     unix    {set fixed "fixed"}
  54.     windows    {set fixed "courier 12"}
  55.     macintosh    {set fixed "monaco 9"}
  56. }
  57. set times [font actual {times 0} -family]
  58.  
  59. test font-1.1 {font command: general} {
  60.     list [catch {font} msg] $msg
  61. } {1 {wrong # args: should be "font option ?arg?"}}
  62. test font-1.2 {font command: actual: arguments} {
  63.     list [catch {font actual xyz -displayof} msg] $msg
  64. } {1 {value for "-displayof" missing}}
  65. test font-1.3 {font command: actual: arguments} {
  66.     list [catch {font actual} msg] $msg
  67. } {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
  68. test font-1.4 {font command: actual: arguments} {
  69.     list [catch {font actual xyz abc def} msg] $msg
  70. } {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
  71. test font-1.5 {font command: actual: arguments} {
  72.     list [catch {font actual {}} msg] $msg
  73. } {1 {font "" doesn't exist}}
  74. test font-1.6 {font command: actual} {unix || mac} {
  75.     string tolower [font actual {-family times} -family]
  76. } {times}
  77. test font-1.7 {font command: actual} {pcOnly} {
  78.     font actual {-family times} -family
  79. } {Times New Roman}
  80. test font-1.8 {font command: actual} {
  81.     lindex [font actual {-family times}] 0
  82. } {-family}
  83.  
  84. test font-2.1 {font command: configure} {
  85.     list [catch {font configure} msg] $msg
  86. } {1 {wrong # args: should be "font configure fontname ?options?"}}
  87. test font-2.2 {font command: configure: non-existent font} {
  88.     list [catch {font configure xyz} msg] $msg
  89. } {1 {named font "xyz" doesn't exist}}
  90. test font-2.3 {font command: configure: "deleted" font} {
  91.     setup
  92.     font create xyz
  93.     .b.f configure -font xyz
  94.     font delete xyz
  95.     list [catch {font configure xyz} msg] $msg
  96. } {1 {named font "xyz" doesn't exist}}
  97. test font-2.4 {font command: configure: get all options} {
  98.     setup
  99.     font create xyz -family xyz
  100.     lindex [font configure xyz] 1
  101. } xyz
  102. test font-2.5 {font command: configure: get one option} {
  103.     setup
  104.     font create xyz -family xyz
  105.     font configure xyz -family
  106. } xyz
  107. test font-2.6 {font command: configure: update existing font} {
  108.     setup
  109.     font create xyz
  110.     font configure xyz -family xyz
  111.     update
  112.     font configure xyz -family
  113. } xyz
  114.  
  115. test font-3.1 {font command: create: make up name} {
  116.     font delete [font create]
  117.     font delete [font create -family xyz]
  118. } {}
  119. test font-3.2 {font command: create: already exists} {
  120.     setup
  121.     font create xyz
  122.     list [catch {font create xyz} msg] $msg
  123. } {1 {font "xyz" already exists}}
  124. test font-3.3 {font command: create: error recreating "deleted" font} {
  125.     setup
  126.     font create xyz
  127.     .b.f configure -font xyz
  128.     font delete xyz
  129.     list [catch {font create xyz -xyz times} msg] $msg
  130. } {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
  131. test font-3.4 {font command: create: recreate "deleted" font} {
  132.     setup
  133.     font create xyz
  134.     .b.f configure -font xyz
  135.     font delete xyz
  136.     font actual xyz
  137.     font create xyz -family times
  138.     update
  139.     font configure xyz -family
  140. } {times}
  141. test font-3.5 {font command: create: bad option creating new font} {
  142.     setup
  143.     list [catch {font create xyz -xyz times} msg] $msg
  144. } {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
  145. test font-3.6 {font command: create: totally new font} {
  146.     setup
  147.     font create xyz -family xyz
  148.     font configure xyz -family
  149. } {xyz}
  150.  
  151. test font-4.1 {font command: delete: arguments} {
  152.     list [catch {font delete} msg] $msg
  153. } {1 {wrong # args: should be "font delete fontname ?fontname ...?"}}
  154. test font-4.2 {font command: delete: loop test} {
  155.     font create a -underline 1
  156.     font create b -underline 1
  157.     font create c -underline 1
  158.     font delete a b c
  159.     list [font actual a -underline] [font actual b -underline] [font actual c -underline]
  160. } {0 0 0}
  161. test font-4.3 {font command: delete: non-existent} {
  162.     setup
  163.     list [catch {font delete xyz} msg] $msg
  164. } {1 {named font "xyz" doesn't exist}}
  165. test font-4.4 {font command: delete: mark for later deletion} {
  166.     setup
  167.     font create xyz
  168.     .b.f configure -font xyz
  169.     font delete xyz
  170.     font actual xyz
  171.     list [catch {font configure xyz} msg] $msg
  172. } {1 {named font "xyz" doesn't exist}}
  173. test font-4.5 {font command: delete: actually delete} {
  174.     setup
  175.     font create xyz -underline 1
  176.     font delete xyz
  177.     font actual xyz -underline
  178. } {0}
  179.  
  180. test font-5.1 {font command: families: arguments} {
  181.     list [catch {font families -displayof} msg] $msg
  182. } {1 {value for "-displayof" missing}}
  183. test font-5.2 {font command: families: arguments} {
  184.     list [catch {font families xyz} msg] $msg
  185. } {1 {wrong # args: should be "font families ?-displayof window?"}}
  186. test font-5.3 {font command: families} {
  187.     font families
  188.     set x {}
  189. } {}
  190.  
  191. test font-6.1 {font command: measure: arguments} {
  192.     list [catch {font actual xyz -displayof} msg] $msg
  193. } {1 {value for "-displayof" missing}}
  194. test font-6.2 {font command: measure: arguments} {
  195.     list [catch {font measure} msg] $msg
  196. } {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
  197. test font-6.3 {font command: measure: arguments} {
  198.     list [catch {font measure xyz abc def} msg] $msg
  199. } {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
  200. test font-6.4 {font command: measure: arguments} {
  201.     list [catch {font measure {} abc} msg] $msg
  202. } {1 {font "" doesn't exist}}
  203. test font-6.5 {font command: measure} {
  204.     expr [font measure $fixed "abcdefg"]==[font measure $fixed "a"]*7
  205. } {1}
  206.  
  207. test font-7.1 {font command: metrics: arguments} {
  208.     list [catch {font metrics} msg] $msg
  209. } {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
  210. test font-7.2 {font command: metrics: get all metrics} {
  211.     catch {unset a}
  212.     array set a [font metrics {-family xyz}]
  213.     set x [lsort [array names a]]
  214.     unset a
  215.     set x    
  216. } {-ascent -descent -fixed -linespace}
  217. test font-7.3 {font command: metrics: get ascent} {
  218.     catch {expr [font metrics $fixed -ascent]}
  219. } {0}
  220. test font-7.4 {font command: metrics: get descent} {
  221.     catch {expr [font metrics {-family xyz} -descent]}
  222. } {0}
  223. test font-7.5 {font command: metrics: get linespace} {
  224.     catch {expr [font metrics {-family fixed} -linespace]}
  225. } {0}
  226. test font-7.6 {font command: metrics: get fixed} {
  227.     catch {expr [font metrics {-family fixed} -fixed]}
  228. } {0}
  229. test font-7.7 {font command: metrics: get ascent} {
  230.     catch {expr [font metrics {-family xyz} -ascent]}
  231. } {0}
  232. test font-7.8 {font command: metrics: get descent} {
  233.     catch {expr [font metrics {-family xyz} -descent]}
  234. } {0}
  235. test font-7.9 {font command: metrics: get linespace} {
  236.     catch {expr [font metrics {-family fixed} -linespace]}
  237. } {0}
  238. test font-7.10 {font command: metrics: get fixed} {
  239.     catch {expr [font metrics {-family fixed} -fixed]}
  240. } {0}
  241. test font-7.11 {font command: metrics: bad metric} {
  242.     list [catch {font metrics {-family fixed} -xyz} msg] $msg
  243. } {1 {bad metric "-xyz": must be -ascent, -descent, -linespace, or -fixed}}
  244.  
  245. test font-8.1 {font command: names: arguments} {
  246.     list [catch {font names xyz} msg] $msg
  247. } {1 {wrong # args: should be "font names"}}
  248. test font-8.2 {font command: names} {
  249.     setup
  250.     font create xyz
  251.     font create abc
  252.     set x [lsort [font names]]
  253.     font delete abc
  254.     font delete xyz
  255.     set x
  256. } {abc xyz}
  257. test font-8.3 {font command: names} {
  258.     setup
  259.     font create xyz
  260.     font create abc
  261.     set x [lsort [font names]]
  262.     .b.f config -font xyz
  263.     font delete xyz
  264.     lappend x [font names]
  265.     font delete abc
  266.     set x
  267. } {abc xyz abc}
  268.  
  269. test font-9.1 {font command: unknown option} {
  270.     list [catch {font xyz} msg] $msg
  271. } {1 {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}}
  272.  
  273. test font-10.1 {UpdateDependantFonts procedure: no users} {
  274.     setup
  275.     font create xyz
  276.     font configure xyz -family times
  277. } {}
  278. test font-10.2 {UpdateDependantFonts procedure: pings the widgets} {
  279.     setup
  280.     font create xyz -family times -size 20
  281.     .b.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0
  282.     set a1 [font measure xyz "abcd"]
  283.     update
  284.     set b1 [winfo reqwidth .b.f]
  285.     font configure xyz -family helvetica -size 20
  286.     set a2 [font measure xyz "abcd"]
  287.     update
  288.     set b2 [winfo reqwidth .b.f]
  289.     expr {$a1==$b1 && $a2==$b2}
  290. } {1}
  291.  
  292. test font-11.1 {Tk_GetFont procedure: bump ref count} {
  293.     setup
  294.     .b.f config -font {-family fixed}
  295.     lindex [font actual {-family fixed}] 0
  296. } {-family}
  297. test font-11.2 {Tk_GetFont procedure: bump ref count of named font, too} {
  298.     setup
  299.     font create xyz
  300.     .b.f config -font xyz
  301.     lindex [font actual xyz] 0
  302. } {-family}
  303. test font-11.3 {Tk_GetFont procedure: get named font} {
  304.     setup
  305.     font create xyz
  306.     .b.f config -font xyz
  307. } {}
  308. test font-11.4 {Tk_GetFont procedure: get native font} {unixOnly} {
  309.     setup
  310.     .b.f config -font fixed
  311. } {}
  312. test font-11.5 {Tk_GetFont procedure: get native font} {pcOnly} {
  313.     setup
  314.     .b.f config -font oemfixed
  315. } {}
  316. test font-11.6 {Tk_GetFont procedure: get native font} {macOnly} {
  317.     setup
  318.     .b.f config -font application
  319. } {}
  320. test font-11.7 {Tk_GetFont procedure: get attribute font} {
  321.     list [catch {.b.f config -font {xxx yyy zzz}} msg] $msg
  322. } {1 {expected integer but got "yyy"}}
  323. test font-11.8 {Tk_GetFont procedure: get attribute font} {
  324.     lindex [font actual {plan 9}] 0
  325. } {-family}
  326. test font-11.9 {Tk_GetFont procedure: no match} {
  327.     list [catch {font actual {}} msg] $msg
  328. } {1 {font "" doesn't exist}}
  329.  
  330. test font-12.1 {Tk_NameOfFont procedure} {
  331.     setup
  332.     .b.f config -font {-family fixed}
  333.     .b.f cget -font
  334. } {-family fixed}
  335.  
  336. test font-13.1 {Tk_FreeFont procedure: one ref} {
  337.     setup
  338.     .b.f config -font {-family fixed}
  339.     destroy .b.f
  340. } {}
  341. test font-13.2 {Tk_FreeFont procedure: multiple ref} {
  342.     setup
  343.     .b.f config -font {-family fixed}
  344.     button .b.b -font {-family fixed}
  345.     destroy .b.f
  346.     set x [.b.b cget -font]
  347.     destroy .b.b
  348.     set x
  349. } {-family fixed}
  350. test font-13.3 {Tk_FreeFont procedure: named font} {
  351.     setup
  352.     font create xyz
  353.     .b.f config -font xyz
  354.     destroy .b.f
  355.     font names
  356. } {xyz}
  357. test font-13.4 {Tk_FreeFont procedure: named font} {
  358.     setup
  359.     font create xyz -underline 1
  360.     .b.f config -font xyz
  361.     font delete xyz
  362.     set x [font actual xyz -underline]
  363.     destroy .b.f
  364.     list [font actual xyz -underline] $x
  365. } {0 1}
  366. test font-13.5 {Tk_FreeFont procedure: named font not deleted yet} {
  367.     setup
  368.     font create xyz
  369.     .b.f config -font xyz
  370.     button .b.b -font xyz
  371.     font delete xyz
  372.     set x [font actual xyz]
  373.     destroy .b.b
  374.     list [lindex [font actual xyz] 0] [lindex $x 0]
  375. } {-family -family}
  376.  
  377. test font-14.1 {Tk_FontId} {
  378.     .b.f config -font "times 20"
  379.     update
  380. } {}
  381.  
  382. test font-15.1 {Tk_FontMetrics procedure} {
  383.     button .b.w1 -text abc
  384.     entry .b.w2 -text abcd
  385.     update
  386.     destroy .b.w1 .b.w2
  387. } {}
  388.  
  389. proc psfontname {name} {
  390.     set a [.b.c itemcget text -font]
  391.     .b.c itemconfig text -font $name
  392.     set post [.b.c postscript]
  393.     .b.c itemconfig text -font $a
  394.     set end [string first "findfont" $post]
  395.     incr end -2
  396.     set post [string range $post [expr $end-70] $end]
  397.     set start [string first "gsave" $post]
  398.     return [string range $post [expr $start+7] end]
  399. }
  400. test font-16.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
  401.     set x [font actual {{itc avant garde} 10} -family]
  402.     if {[string match *avant*garde $x]} {
  403.     psfontname "{itc avant garde} 10"
  404.     } else {
  405.     set x {AvantGarde-Book}
  406.     }
  407. } {AvantGarde-Book}
  408. test font-16.2 {Tk_PostscriptFontName procedure: native} {pcOnly} {
  409.     psfontname "arial 10"
  410. } {Helvetica}
  411. test font-16.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
  412.     psfontname "{times new roman} 10"
  413. } {Times-Roman}
  414. test font-16.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
  415.     psfontname "{courier new} 10"
  416. } {Courier}
  417. test font-16.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
  418.     psfontname "geneva 10"
  419. } {Helvetica}
  420. test font-16.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
  421.     psfontname "{new york} 10"
  422. } {Times-Roman}
  423. test font-16.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
  424.     psfontname "monaco 10"
  425. } {Courier}
  426. test font-16.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
  427.     set x [font actual {{lucida bright} 10} -family]
  428.     if {[string match lucida*bright $x]} {
  429.     psfontname "{lucida bright} 10"
  430.     } else {
  431.     set x {LucidaBright}
  432.     }
  433. } {LucidaBright}
  434. test font-16.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
  435.     psfontname "{new century schoolbook} 10"
  436. } {NewCenturySchlbk-Roman}
  437. set i 10
  438. foreach p {
  439.     {"avantgarde" AvantGarde-Book AvantGarde-Demi AvantGarde-BookOblique AvantGarde-DemiOblique}
  440.     {"bookman" Bookman-Light Bookman-Demi Bookman-LightItalic Bookman-DemiItalic}
  441.     {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
  442.     {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
  443.     {"new century schoolbook" NewCenturySchlbk-Roman NewCenturySchlbk-Bold NewCenturySchlbk-Italic NewCenturySchlbk-BoldItalic}
  444.     {"palatino" Palatino-Roman Palatino-Bold Palatino-Italic Palatino-BoldItalic}
  445.     {"symbol" Symbol Symbol Symbol Symbol}
  446.     {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
  447.     {"zapfchancery" ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic}
  448.     {"zapfdingbats" ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats}
  449. } {
  450.     test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
  451.     set family [lindex $p 0]
  452.     set x {}
  453.     set i 1
  454.     foreach slant {roman italic} {
  455.         foreach weight {normal bold} {
  456.         set name [list $family 12 $slant $weight]
  457.         if {[font actual $name -family] == $family} {
  458.             lappend x [psfontname $name]
  459.         } else {
  460.             lappend x [lindex $p $i]
  461.         }
  462.         incr i
  463.         }
  464.     }
  465.         incr i
  466.     set x
  467.     } [lrange $p 1 end]
  468. }
  469. foreach p {
  470.     {"arial" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
  471.     {"courier new" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
  472.     {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
  473.     {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
  474.     {"times new roman" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
  475. } {
  476.     test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} {
  477.     set family [lindex $p 0]
  478.     set x {}
  479.     foreach slant {roman italic} {
  480.         foreach weight {normal bold} {
  481.         lappend x [psfontname [list $family 12 "$slant $weight"]]
  482.         }
  483.     }
  484.         incr i
  485.     set x
  486.     } [lrange $p 1 end]
  487. }
  488. foreach p {
  489.     {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
  490.     {"geneva" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
  491.     {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
  492.     {"monaco" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
  493.     {"new york" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
  494.     {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
  495.     {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
  496. } {
  497.     test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} {
  498.     set family [lindex $p 0]
  499.     set x {}
  500.     foreach slant {roman italic} {
  501.         foreach weight {normal bold} {
  502.         lappend x [psfontname [list $family 12 $slant $weight]]
  503.         }
  504.     }
  505.     incr i
  506.     set x
  507.     } [lrange $p 1 end]
  508. }
  509.  
  510. test font-17.1 {Tk_UnderlineChars procedure} {
  511.     text .b.t
  512.     .b.t insert 1.0 abc\tdefg
  513.     .b.t tag config sel -underline 1
  514.     .b.t tag add sel 1.0 end
  515.     update
  516. } {}
  517.  
  518. setup
  519. test font-18.1 {Tk_ComputeTextLayout: empty string} {
  520.     .b.l config -text ""
  521. } {}
  522. test font-18.2 {Tk_ComputeTextLayout: simple string} {
  523.     .b.l config -text "000"
  524.     getsize
  525. } "[expr $ax*3] $ay"
  526. test font-18.3 {Tk_ComputeTextLayout: find special chars} {
  527.     .b.l config -text "000\n000"
  528.     getsize
  529. } "[expr $ax*3] [expr $ay*2]"
  530. test font-18.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} {
  531.     .b.l config -text "000\n000"
  532.     getsize
  533. } "[expr $ax*3] [expr $ay*2]"
  534. test font-18.5 {Tk_ComputeTextLayout: break line} {
  535.     .b.l config -text "000\t00000" -wrap [expr 9*$ax]
  536.     set x [getsize]
  537.     .b.l config -wrap 0
  538.     set x
  539. } "[expr 8*$ax] [expr 2*$ay]"
  540. test font-18.6 {Tk_ComputeTextLayout: normal ended on special char} {
  541.     .b.l config -text "000\n000"
  542. } {}
  543. test font-18.7 {Tk_ComputeTextLayout: special char was \n} {
  544.     .b.l config -text "000\n0000"
  545.     getsize
  546. } "[expr $ax*4] [expr $ay*2]"
  547. test font-18.8 {Tk_ComputeTextLayout: special char was \t} {
  548.     .b.l config -text "000\t00"
  549.     getsize
  550. } "[expr $ax*10] $ay"
  551. test font-18.9 {Tk_ComputeTextLayout: tab didn't cause break} {
  552.     set x {}
  553.     .b.l config -text "000\t000"
  554.     lappend x [getsize]
  555.     .b.l config -text "000\t000" -wrap [expr 100*$ax]
  556.     lappend x [getsize]
  557.     .b.l config -wrap 0
  558.     set x
  559. } "{[expr $ax*11] $ay} {[expr $ax*11] $ay}"
  560. test font-18.10 {Tk_ComputeTextLayout: tab caused break} {
  561.     set x {}
  562.     .b.l config -text "000\t"
  563.     lappend x [getsize]
  564.     .b.l config -text "000\t00" -wrap [expr $ax*6]
  565.     lappend x [getsize]
  566.     .b.l config -wrap 0
  567.     set x
  568. } "{[expr $ax*3] $ay} {[expr $ax*3] [expr $ay*2]}"
  569. test font-18.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
  570.     set x {}
  571.     .b.l config -text "000            000" -wrap [expr $ax*5]
  572.     lappend x [getsize]
  573.     .b.l config -text "000            "
  574.     lappend x [getsize]
  575.     .b.l config -wrap 0
  576.     set x
  577. } "{[expr $ax*3] [expr $ay*2]} {[expr $ax*3] $ay}"
  578. test font-18.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} {
  579.     set x {}
  580.     .b.l config -text "000            0000" -wrap [expr $ax*5]
  581.     lappend x [getsize]
  582.     .b.l config -text "000\t00            0000" -wrap [expr $ax*12]
  583.     lappend x [getsize]
  584.     .b.l config -wrap 0
  585.     set x
  586. } "{[expr $ax*4] [expr $ay*2]} {[expr $ax*10] [expr $ay*2]}"
  587. test font-18.13 {Tk_ComputeTextLayout: many lines -> realloc line array} {
  588.     .b.l config -text "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
  589.     getsize
  590. } "1 [expr $ay*128]"
  591. test font-18.14 {Tk_ComputeTextLayout: justification} {
  592.     csetup "000\n00000"
  593.     set x {}
  594.     .b.c itemconfig text -just left
  595.     lappend x [.b.c index text @[expr $ax*2],0]
  596.     .b.c itemconfig text -just center
  597.     lappend x [.b.c index text @[expr $ax*2],0]
  598.     .b.c itemconfig text -just right
  599.     lappend x [.b.c index text @[expr $ax*2],0]
  600.     .b.c itemconfig text -just left
  601.     set x
  602. } {2 1 0}
  603.  
  604. test font-19.1 {Tk_FreeTextLayout procedure} {
  605.     setup
  606.     .b.f config -text foo
  607.     .b.f config -text boo
  608. } {}
  609.     
  610. test font-20.1 {Tk_DrawTextLayout procedure: auto-detect last char} {
  611.     .b.f config -text foo
  612. } {}
  613. test font-20.2 {Tk_DrawTextLayout procedure: multiple chunks} {
  614.     csetup "000\t00\n000"
  615. } {}
  616. test font-20.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} {
  617.     csetup "000\t00"
  618.     .b.c select from text 3
  619.     .b.c select to text 5
  620. } {}
  621. test font-20.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} {
  622.     .b.c select from text 3
  623.     .b.c select to text 5
  624. } {}
  625. test font-20.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} {
  626.     .b.c select from text 2
  627.     .b.c select to text 2
  628. } {}
  629. test font-20.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} {
  630.     .b.c select from text 4
  631.     .b.c select to text 4
  632. } {}
  633.  
  634. test font-21.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
  635.     .b.f config -text "foo" -under -1
  636. } {}
  637. test font-21.2 {Tk_UnderlineTextLayout procedure: underline not visible} {
  638.     .b.f config -text "000          00000" -wrap [expr $ax*7] -under 10
  639. } {}
  640. test font-21.3 {Tk_UnderlineTextLayout procedure: underline is visible} {
  641.     .b.f config -text "000          00000" -wrap [expr $ax*7] -under 5
  642.     .b.f config -wrap -1 -under -1
  643. } {}
  644.     
  645. test font-22.1 {Tk_PointToChar procedure: above all lines} {
  646.     csetup "000"
  647.     .b.c index text @-1,0
  648. } {0}
  649. test font-22.2 {Tk_PointToChar procedure: no chars} {
  650.     # After fixing the following bug:
  651.     #
  652.     # In canvas text item, it was impossible to click to position the
  653.     # insertion point just after the last character.
  654.     #
  655.     # introduced another bug that Tk_PointToChar() would return a character
  656.     # index of 1 if TextLayout contained 0 characters.
  657.  
  658.     csetup ""
  659.     .b.c index text @100,100
  660. } {0}
  661. test font-22.3 {Tk_PointToChar procedure: loop test} {
  662.     csetup "000\n000\n000\n000"
  663.     .b.c index text @10000,0
  664. } {3}
  665. test font-22.4 {Tk_PointToChar procedure: intersect line} {
  666.     csetup "000\n000\n000"
  667.     .b.c index text @0,$ay
  668. } {4}
  669. test font-22.5 {Tk_PointToChar procedure: to the left of all chunks} {
  670.     .b.c index text @-100,$ay
  671. } {4}
  672. test font-22.6 {Tk_PointToChar procedure: past any possible chunk} {
  673.     .b.c index text @100000,$ay
  674. } {7}
  675. test font-22.7 {Tk_PointToChar procedure: which chunk on this line} {
  676.     csetup "000\n000\t000\t000\n000"
  677.     .b.c index text @[expr $ax*2],$ay
  678. } {6}
  679. test font-22.8 {Tk_PointToChar procedure: which chunk on this line} {
  680.     csetup "000\n000\t000\t000\n000"
  681.     .b.c index text @[expr $ax*10],$ay
  682. } {10}
  683. test font-22.9 {Tk_PointToChar procedure: in special chunk} {
  684.     csetup "000\n000\t000\t000\n000"
  685.     .b.c index text @[expr $ax*6],$ay
  686. } {7}
  687. test font-22.10 {Tk_PointToChar procedure: past all chars in chunk} {
  688.     csetup "000 0000000"
  689.     .b.c itemconfig text -width [expr $ax*5]
  690.     set x [.b.c index text @[expr $ax*5],0]
  691.     .b.c itemconfig text -width 0
  692.     set x
  693. } {3}
  694. test font-22.11 {Tk_PointToChar procedure: below all chunks} {
  695.     csetup "000 0000000"
  696.     .b.c index text @0,1000000
  697. } {11}
  698.     
  699. test font-23.1 {Tk_CharBBox procedure: index < 0} {
  700.     .b.f config -text "000" -underline -1
  701. } {}
  702. test font-23.2 {Tk_CharBBox procedure: loop} {
  703.     .b.f config -text "000\t000\t000\t000" -underline 9
  704. } {}
  705. test font-23.3 {Tk_CharBBox procedure: special char} {
  706.     .b.f config -text "000\t000\t000" -underline 7
  707. } {}
  708. test font-23.4 {Tk_CharBBox procedure: normal char} {
  709.     .b.f config -text "000" -underline 1
  710. } {}
  711. test font-23.5 {Tk_CharBBox procedure: right edge of bbox truncated} {
  712.     .b.f config -text "0    0000" -wrap [expr $ax*4] -under 2
  713.     .b.f config -wrap 0
  714. } {}
  715. test font-23.6 {Tk_CharBBox procedure: bbox pegged to right edge} {
  716.     .b.f config -text "0    0000" -wrap [expr $ax*4] -under 3
  717.     .b.f config -wrap 0
  718. } {}
  719.  
  720. .b.c bind all <Enter> {lappend x [.b.c index current @%x,%y]}
  721.  
  722. test font-24.1 {Tk_TextLayoutToPoint procedure: loop once} {
  723.     csetup "000\n000\n000"
  724.     set x {}
  725.     event generate .b.c <Leave>
  726.     event generate .b.c <Enter> -x 0 -y 0
  727.     set x
  728. } {0}
  729. test font-24.2 {Tk_TextLayoutToPoint procedure: loop multiple} {
  730.     csetup "000\n000\n000"
  731.     set x {}
  732.     event generate .b.c <Leave>
  733.     event generate .b.c <Enter> -x $ax -y $ay
  734.     set x
  735. } {5}
  736. test font-24.3 {Tk_TextLayoutToPoint procedure: loop to end} {
  737.     csetup "000\n0\n000"
  738.     set x {}
  739.     event generate .b.c <Leave>
  740.     event generate .b.c <Enter> -x [expr $ax*2] -y $ay
  741.     set x
  742. } {}
  743. test font-24.4 {Tk_TextLayoutToPoint procedure: hit a special char (tab)} {
  744.     csetup "000\t000\n000"
  745.     set x {}
  746.     event generate .b.c <Leave>
  747.     event generate .b.c <Enter> -x [expr $ax*6] -y 0
  748.     set x
  749. } {3}
  750. test font-24.5 {Tk_TextLayoutToPoint procedure: ignore newline} {
  751.     csetup "000\n0\n000"
  752.     set x {}
  753.     event generate .b.c <Leave>
  754.     event generate .b.c <Enter> -x [expr $ax*2] -y $ay
  755.     set x
  756. } {}
  757. test font-24.6 {Tk_TextLayoutToPoint procedure: ignore spaces at eol} {
  758.     csetup "000\n000      000000000"
  759.     .b.c itemconfig text -width [expr $ax*10]
  760.     set x {}
  761.     event generate .b.c <Leave>
  762.     event generate .b.c <Enter> -x [expr $ax*5] -y $ay
  763.     .b.c itemconfig text -width 0
  764.     set x
  765. } {}
  766. .b.c itemconfig text -justify center
  767. test font-24.7 {Tk_TextLayoutToPoint procedure: on left side} {
  768.     csetup "0\n000"
  769.     set x {}
  770.     event generate .b.c <Leave>
  771.     event generate .b.c <Enter> -x 0 -y 0
  772.     set x
  773. } {}
  774. test font-24.8 {Tk_TextLayoutToPoint procedure: on right side} {
  775.     csetup "0\n000"
  776.     set x {}
  777.     event generate .b.c <Leave>
  778.     event generate .b.c <Enter> -x [expr $ax*2] -y 0
  779.     set x
  780. } {}
  781. test font-24.9 {Tk_TextLayoutToPoint procedure: inside line} {
  782.     csetup "0\n000"
  783.     set x {}
  784.     event generate .b.c <Leave>
  785.     event generate .b.c <Enter> -x $ax -y 0
  786.     set x
  787. } {0}
  788. test font-24.10 {Tk_TextLayoutToPoint procedure: above line} {
  789.     csetup "0\n000"
  790.     set x {}
  791.     event generate .b.c <Leave>
  792.     event generate .b.c <Enter> -x 0 -y 0
  793.     set x
  794. } {}
  795. test font-24.11 {Tk_TextLayoutToPoint procedure: below line} {
  796.     csetup "000\n0"
  797.     set x {}
  798.     event generate .b.c <Leave>
  799.     event generate .b.c <Enter> -x 0 -y $ay
  800.     set x
  801. } {}
  802. test font-24.12 {Tk_TextLayoutToPoint procedure: in line} {
  803.     csetup "0\n000"
  804.     set x {}
  805.     event generate .b.c <Leave>
  806.     event generate .b.c <Enter> -x $ax -y $ay
  807.     set x
  808. } {3}
  809. .b.c itemconfig text -justify left
  810. test font-24.13 {Tk_TextLayoutToPoint procedure: exact hit} {
  811.     csetup "000"
  812.     set x {}
  813.     event generate .b.c <Leave>
  814.     event generate .b.c <Enter> -x $ax -y 0
  815.     set x
  816. } {1}
  817.  
  818. test font-25.1 {Tk_TextLayoutToArea procedure: loop once} {
  819.     csetup "000\n000\n000"
  820.     .b.c find oo that font name doesn't
  821. # look like a native X font, so that ParseFontName or TkParseXLFD will
  822. # be called.
  823.  
  824. setup
  825.  
  826. test font-32.1 {ParseFontName procedure: begins with -} {
  827.     lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
  828. } $times
  829. test font-32.2 {ParseFontName procedure: begins with -*} {
  830.     lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
  831. } $times
  832. test font-32.3 {ParseFontName procedure: begins with -, doesn't look like list} {
  833.     lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
  834. } $times
  835. test font-32.4 {ParseFontName procedure: begins with -, looks like list} {
  836.     lindex [font actual {-family times}] 1
  837. } $times
  838. test font-32.5 {ParseFontName procedure: begins with *} {
  839.     lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
  840. } $times
  841. test font-32.6 {ParseFontName procedure: begins with *} {
  842.     font actual *-times-xyz -family
  843. } $times
  844. test font-32.7 {ParseFontName procedure: arguments} {
  845.     list [catch {font actual {}} msg] $msg
  846. } {1 {font "" doesn't exist}}
  847. test font-32.8 {ParseFontName procedure: arguments} {
  848.     list [catch {font actual {times 20 xyz xyz}} msg] $msg
  849. } {1 {unknown font style "xyz"}}
  850. test font-32.9 {ParseFontName procedure: arguments} {
  851.     list [catch {font actual {times xyz xyz}} msg] $msg
  852. } {1 {expected integer but got "xyz"}}
  853. test font-32.10 {ParseFontName procedure: stylelist loop} {macOnly} {
  854.     lrange [font actual {times 12 bold italic overstrike underline}] 4 end
  855. } {-weight bold -slant italic -underline 1 -overstrike 0}
  856. test font-32.11 {ParseFontName procedure: stylelist loop} {unixOrPc} {
  857.     lrange [font actual {times 12 bold italic overstrike underline}] 4 end
  858. } {-weight bold -slant italic -underline 1 -overstrike 1}
  859. test font-32.12 {ParseFontName procedure: stylelist error} {
  860.     list [catch {font actual {times 12 bold xyz}} msg] $msg
  861. } {1 {unknown font style "xyz"}}
  862.  
  863. test font-33.1 {TkParseXLFD procedure: initial dash} {
  864.     font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-* -family
  865. } $times
  866. test font-33.2 {TkParseXLFD procedure: no initial dash} {
  867.     font actual *-times-*-*-*-*-*-*-*-*-*-*-*-xyz -family
  868. } $times
  869. test font-33.3 {TkParseXLFD procedure: not enough fields} {
  870.     font actual -xyz-times-*-*-* -family
  871. } $times
  872. test font-33.4 {TkParseXLFD procedure: all fields unspecified} {
  873.     lindex [font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*] 0
  874. } {-family}
  875. test font-33.5 {TkParseXLFD procedure: all fields specified} {
  876.     lindex [font actual -foundry-times-weight-slant-setwidth-addstyle-10-10-10-10-spacing-avgwidth-registry-encoding] 1
  877. } $times
  878. test font-33.6 {TkParseXLFD procedure: arguments} {
  879.     # XLFD with bad pointsize: fallback to some system font.
  880.     font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-*
  881.     set x {}
  882. } {}
  883. test font-33.7 {TkParseXLFD procedure: arguments} {
  884.     # XLFD with bad pixelsize: fallback to some system font.
  885.     font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-*
  886.     set x {}
  887. } {}
  888. test font-33.8 {TkParseXLFD procedure: pixelsize specified} {
  889.     font metrics -xyz-times-*-*-*-*-12-*-*-*-*-*-*-* -linespace
  890.     set x {}
  891. } {}
  892. test font-33.9 {TkParseXLFD procedure: weird pixelsize specified} {
  893.     font metrics {-xyz-times-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*-*} -linespace
  894.     set x {}
  895. } {}
  896. test font-33.10 {TkParseXLFD procedure: pointsize specified} {
  897.     font metrics -xyz-times-*-*-*-*-*-120-*-*-*-*-*-* -linespace
  898.     set x {}
  899. } {}
  900. test font-33.11 {TkParseXLFD procedure: weird pointsize specified} {
  901.     font metrics {-xyz-times-*-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*} -linespace
  902.     set x {}
  903. } {}
  904.  
  905. test font-34.1 {FieldSpecified procedure: specified vs. non-specified} {
  906.     font actual -xyz--*-*-*-*-*-*-*-*-*-*-*-*
  907.     font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*
  908.     font actual -xyz-?-*-*-*-*-*-*-*-*-*-*-*-*
  909.     lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
  910. } $times
  911.  
  912. test font-35.1 {NewChunk procedure: test realloc} {
  913.     .b.f config -text "xxx\nxxx\txxx\nxxx\t\t\t"
  914. } {}
  915.  
  916. destroy .b
  917.